home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 013 / findup21.arc / FINDUP21.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1985-10-27  |  40.7 KB  |  915 lines
  1.  
  2. program FindDuplicateFiles;
  3. {   ╔══════════════════════════════════════════════════════════════════════╗
  4.     ║  Copyright March 25, 1985                                            ║
  5.     ║                                                                      ║
  6.     ║  It must  not be sold to anyone for any purpose it has been placed   ║
  7.     ║  in the public  domain for the use of computer hackers who love to   ║
  8.     ║  play with their machines.                                           ║
  9.     ╠══════════════════════════════════════════════════════════════════════╣
  10.     ║                                                                      ║
  11.     ║                Version 1.0 by Karson Morrison                        ║
  12.     ║                                                                      ║
  13.     ║       Anyone who modifies this program place your name and the new   ║
  14.     ║       version number by it.  Place a comment before and after your   ║
  15.     ║       changes  and  place  the  version  number  as  part of those   ║
  16.     ║       comments.                                                      ║
  17.     ║                                                                      ║
  18.     ║       Please  send  me a copy of the changes that you have made so   ║
  19.     ║       that I may include them in the master.  I don't have all the   ║
  20.     ║       answers I just  started  it.  I am not very knowledgeable at   ║
  21.     ║       Pascal and  I may have made some routines that could be made   ║
  22.     ║       more efficient  by  using  other  coding.  If you find those   ║
  23.     ║       please  let  me  know  and  I  will include them to make the   ║
  24.     ║       program faster.  I cannot make the sort  any  faster because   ║
  25.     ║       it was coded by  Borland.  Anyone  who  sends  me  changes I   ║
  26.     ║       will  include on  a list  that  I will notify of all changes   ║
  27.     ║       that are made to the program.  Keep those cards and  letters   ║
  28.     ║       flowing.                                                       ║
  29.     ╠══════════════════════════════════════════════════════════════════════╣
  30.     ║  This is a program to list out all of the files on a  disk  sorted   ║
  31.     ║  in file order.  It  will  also  tell you of any  duplicate  files   ║
  32.     ║  within different directories.   (See Version 2.0 changes)           ║
  33.     ╠══════════════════════════════════════════════════════════════════════╣
  34.     ║  Requirements:                                                       ║
  35.     ║                                                                      ║
  36.     ║  This program  requires  Turbo  Pascal  2.0  and the Turbo Toolbox   ║
  37.     ║  pascal  program  SORT.BOX.  The .COM  version  has  already  been   ║
  38.     ║  compiled with the SORT in it.                                       ║
  39.     ╠══════════════════════════════════════════════════════════════════════╣
  40.     ║  This program was written by and Copyright (C) 1985 by               ║
  41.     ║                                                                      ║
  42.     ║                              Karson W. Morrison                      ║
  43.     ║                              RD. 1, Box 531,                         ║
  44.     ║                              Ringoes, NJ. 08551                      ║
  45.     ║                              (201) 788-1846                          ║
  46.     ╠══════════════════════════════════════════════════════════════════════╣
  47.     ║  Acknowledgements:                                                   ║
  48.     ║                                                                      ║
  49.     ║  I used info picked up from a  bulletin  board  for  the  routines   ║
  50.     ║  to get system date and time.  That info. was created by  Jon Gray   ║
  51.     ║  of the IBM PC USERS GROUP Milwaukee.  It did have  a  bug  though   ║
  52.     ║  that would only work with months of 2 digits (now fixed by me).     ║
  53.     ║                                                                      ║
  54.     ║  I  also  used  routines  provided  by  Borland for the reading of   ║
  55.     ║  directories. This info was provided in their Turbo Tutor package.   ║
  56.     ║                                                                      ║
  57.     ║  Tears:                                                              ║
  58.     ║                                                                      ║
  59.     ║  A lot of hours went into this program please do not revise it and   ║
  60.     ║  leave out the credit that I have done most of the work.             ║
  61.     ║                                                                      ║
  62.     ║  Purpose:                                                            ║
  63.     ║                                                                      ║
  64.     ║  Every time I turned  around I  was  trying  to delete some of the   ║
  65.     ║  files on my hard disk because I was  always  ending  up with only   ║
  66.     ║  300 - 400 K left.  I kept  thinking  there  must be an easier way   ║
  67.     ║  to know if there were duplicate files.                              ║
  68.     ║                                                                      ║
  69.     ║                     This is the result                               ║
  70.     ╠══════════════════════════════════════════════════════════════════════╣
  71.     ║                Version 2.0   March 25, 1985                          ║
  72.     ║                    Made by the author.                               ║
  73.     ║                                                                      ║
  74.     ║  Updated program to put file size on  each line and put in a major   ║
  75.     ║  option for Sorted Tree Directories.                                 ║
  76.     ║                                                                      ║
  77.     ║  Every Tree Dir program that I have seen always  intersperces  sub   ║
  78.     ║  directories files where it finds them  with  the regular files in   ║
  79.     ║  that directory.  This program  put  files  together,  followed by   ║
  80.     ║  the sub directory files in  that directory.  The sub  directories   ║
  81.     ║  are sorted, and  then  printed  in  the  sorted  order within the   ║
  82.     ║  the parent directory.                                               ║
  83.     ║                                                                      ║
  84.     ║  Updated program to put output on a file DIRECTRY.DTA as an option   ║
  85.     ║  for later printing or other modification.                           ║
  86.     ╠══════════════════════════════════════════════════════════════════════╣
  87.     ║                                                                      ║
  88.     ║                Version 2.1   October 27, 1985                        ║
  89.     ║                  Modifications by Ray Bobak                          ║
  90.     ║                     Sysop PC-RAIN Node II                            ║
  91.     ║                     Wappingers Falls, NY                             ║
  92.     ║                     914-462-7674 (data)                              ║
  93.     ║                                                                      ║
  94.     ║  Updated code so that the input string from the command line was a   ║
  95.     ║  list of drives to perform the services on.  This change was made    ║
  96.     ║  to allow SYSOP's with multiple download drives to scan all his      ║
  97.     ║  download drives for duplicates.  (Here you go Charlie, your name    ║
  98.     ║  in lights.)  This version was inspired by Charlie Innusa, a sysop   ║
  99.     ║  running RBBS-PC on only nine 32 Megabyte download drives.  You can  ║
  100.     ║  call his BBS, PC-Rockland at 914-353-2157 Subscription node, or     ║
  101.     ║                               914-353-2176 free node                 ║
  102.     ║                                                                      ║
  103.     ║  FINDUP21 ABCDEF - find duplicate files across drives A, B, C, ...   ║
  104.     ║                    approximate time to handle 10K files = 20 Min     ║
  105.     ║                    for reading of directory and sorting.  Note,      ║
  106.     ║                    sort will need 800K of diskspace for the sort.    ║
  107.     ║                                                                      ║
  108.     ╚══════════════════════════════════════════════════════════════════════╝
  109.  
  110.     ╔══════════════════════════════════════════════════════════════════════╗
  111.     ║                                                                      ║
  112.     ║  NOTE:                                                               ║
  113.     ║                                                                      ║
  114.     ║  A command line is used as input if entered else the default drive   ║
  115.     ║  is used.                                                            ║
  116.     ╚══════════════════════════════════════════════════════════════════════╝
  117. }
  118. const
  119.   Max_dir              = 300;   { Max number of directory entries }
  120.                                     { it can be upped }
  121. type
  122.   DirRec =                               { My Sort Record }
  123.     record
  124.         FileDrive      : string[1];      {drive leter of file} {3.0}
  125.         FileNme        : string[14];     { File Name }
  126.         FileDir        : string[36];     { Concatinated Directory Tree }
  127.         FileAttributes : string[5];      { Codes for System, hidden, dir etc. }
  128.         FileMO         : integer;        { File creation Month }
  129.         FileDA         : integer;        { File creation Day }
  130.         FileYR         : integer;        { File creation Year }
  131.         FileHR         : integer;        { File creation Hour  24 hour clock }
  132.         FileMN         : integer;        { File creation Minute 60 min clock }
  133.         FileSize       : real;           { File size }
  134.         FileSiLow      : integer;        { Low order byte file size }
  135.         FileSiHigh     : integer;        { High order byte file size }
  136.     end;
  137.   String20             = string [ 20 ];
  138.   RegRec =                               { The data to pass to DOS }
  139.     record
  140.       AX, BX, CX, DX, BP, SI, DI, DS, ES, Flags : Integer;
  141.     end;
  142.  
  143. var
  144.   FilVar               : text;                      { Is it CON: or LST: }
  145.   DirectryRec          : DirRec;
  146.   DiskOutput,                            { Do we want Disk output }
  147.   Print,                                 { Do we want paper or screen }
  148.   FirstTime,                             { First time in this routine }
  149.   DirCont,                               { is this dir on the previous page }
  150.   NotDir               : Boolean;        { This is not a directory rec I read }
  151.   Regs                 : RegRec;         { Dos Registers }
  152.   DTA                  : array [ 1..43 ] of Byte;  { Back from DOS }
  153.   Mask                 : array [ 1..50 ] of Char;  { What do we read DOS calls }
  154.   NamR                 : String20;       { The file name from the DTA }
  155.   timestr              : string[11];     { like it says }
  156.   datestr              : string[15];     {     "        }
  157.   ErrResult,                             { Error Switches }
  158.   Error,
  159.   X, Y, I, Z           : Integer;        { screen position }
  160.   Buffer,                                { Used in file name manipulation }
  161.   Buffer1,                               {               "                }
  162.   Buffer2              : String [50];    {               "                }
  163.   DirTable             : Array [ 1..Max_dir ] of string[50];  { Dirs Found }
  164.   E, E_use,                              { Working integers }
  165.   A, B, C,                               {        "         }
  166.   PageNo               : integer;        { Page being printed }
  167.   OldName              : string [14];    { Work areas for duplicate check }
  168.   OldDir               : string [36];    { Same as DirRec }
  169.   OldAttr              : string[5];           { " }
  170.   OldMO,                                      { " }
  171.   OldDA,                                      { " }
  172.   OldYR,                                      { " }
  173.   OldHR,                                      { " }
  174.   OldMN                : integer;             { " }
  175.   OldSI                : real;                { " }
  176.   WrkMN                : string[2];      { Work Month }
  177.   WorkName             : string[14];
  178.   Option               : string[1];      { What option did you want from screen }
  179.   MatchFound           : Boolean;        { Oh! Oh! you have two files the same }
  180.   ScreenLines          : integer;        { How many lines I've printed }
  181.   Temp                 : string[1];      { This is not the Temperature }
  182.   SortResult,                            { Did the sort work }
  183.   FileDateDos,                           { Dos format for date }
  184.   FileHourDos,                           { Dos format for Hour }
  185.   FileYear,                              { File Year actual not just since 1980 }
  186.   FileMonth,                             { File month }
  187.   FileDay,                               { File Day }
  188.   FileHour,                              { File Hour }
  189.   FileMinute,                            { File Minute }
  190.   FileWork,                              { Work area }
  191.   FileWork2,                             { Work area }
  192.   FileLow,                               { Work area }
  193.   FileHIgh,                              { Work area }
  194.   NumberRecs           : integer;        { How many records on disk }
  195.   FileWork3            : real;           { Work area for file size }
  196.   DiskUse              : real;           { Work area for Disk space in use }
  197.   FileUse              : integer;        { Work area for file space used }
  198.   FileUse2K            : integer;        { Work area if 2K blocks }
  199.   FileUse4K            : integer;        { Work area if 4K blocks }
  200.   FileUseWork          : string[11];     { Work area to print disk use }
  201.   drive_ctr : integer;           {3.0}
  202.   CurDrive : String[1];          {3.0}
  203.   DriveString : string[30];      {3.0}
  204.  
  205. {$ISORT.BOX}              { This is from Borland in their Toolbox package }
  206.  
  207. procedure date;           { What is todays date }
  208. const
  209.     montharr : array [1..12] of string[3] =
  210.                ('Jan','Feb','Mar','Apr','May',
  211.                 'Jun','Jul','Aug','Sep','Oct','Nov','Dec');
  212.  
  213. var
  214.     regs:regrec;
  215.     month, day:string[2];
  216.     year:string[4];
  217.     dx, cx, result, tmpmonth:integer;
  218.  
  219. begin
  220.     with regs do
  221.     begin
  222.       ax:= $2a shl 8;
  223.     end;
  224.     msdos (regs);
  225.     with regs do
  226.     begin
  227.       str(cx:4, year);
  228.       str(dx shr 8:2, month);
  229.       str(dx mod 256:2, day);
  230.     end;
  231.     if month[1] = ' ' then month[1] := '0';
  232.     val (month, tmpmonth, result);
  233.     datestr:= day + '-' + montharr[tmpmonth] + '-' + year
  234. end; { procedure date }
  235.  
  236. procedure time;               { What is the current time }
  237. var                           { Not on your watch! in the computer }
  238.   regs:regrec;
  239.   ah, al, ch, cl, dh:byte;
  240.   hour, min, sec, ampm:string[2];
  241.   tmptime, result:integer;
  242.  
  243. begin
  244.   ah := $2c;
  245.   with regs do
  246.   begin
  247.     ax := ah shl 8 + al;
  248.   end;
  249.   intr($21,regs);
  250.   with regs do
  251.   begin
  252.     str(cx shr 8:2, hour);
  253.     str(cx mod 256:2, min);
  254.     str(dx shr 8:2, sec);
  255.   end;
  256.   if (hour > '12') then
  257.     begin
  258.       val (hour, tmptime, result);
  259.       tmptime:= tmptime - 12;
  260.       str (tmptime:2, hour);
  261.       ampm:= 'pm'
  262.     end
  263.   else
  264.     ampm:= 'am';
  265.   if (min[1] = ' ') then
  266.     min[1]:= '0';
  267.   if (sec[1] = ' ') then
  268.     sec[1]:= '0';
  269.   timestr := hour + ':' + min + ':' + sec + ' ' + ampm;
  270. end; { procedure time }
  271.  
  272. procedure SetUpDTA;
  273. begin
  274.   Regs.AX := $1A00;             { Function used to set the DTA }
  275.   Regs.DS := Seg(DTA);          { store the parameter segment in DS }
  276.   Regs.DX := Ofs(DTA);          {   "    "      "     offset in DX }
  277.   MSDos(Regs);                  { Set DTA location }
  278.   Error := Regs.AX and $FF;
  279. end;
  280.  
  281. procedure ReadFirst;
  282. begin
  283.   Regs.AX := $4E00;             { Get first directory entry }
  284.   Regs.DS := Seg(Mask);         { Point to the file Mask }
  285.   Regs.DX := Ofs(Mask);
  286.   Regs.CX := 23;                { Store the option }
  287.   MSDos(Regs);                  { Execute MSDos call }
  288.   Error := Regs.AX and $FF;     { Get Error return }
  289. end;
  290.  
  291. procedure ReadNext;
  292. begin
  293.     Error := 0;
  294.     Regs.AX := $4F00;           { Function used to get the next }
  295.                                 { directory entry }
  296.     Regs.CX := 23;              { Set the file option }
  297.     MSDos( Regs );              { Call MSDos }
  298.     Error := Regs.AX and $FF;   { get the Error return }
  299. end;
  300.  
  301. procedure SetUpNamR;            { Get the file name from the directory }
  302. begin
  303.     repeat
  304.       NamR[I] := Chr(Mem[Seg(DTA):Ofs(DTA)+29+I]);
  305.       I := I + 1;
  306.     until not (NamR[I-1] in [' '..'~']) or (I>20);
  307.  
  308.   NamR[0] := Chr(I-1);          { set string length because assigning }
  309.                                 { by element does not set length }
  310. end;
  311.  
  312. procedure Set_up_Dir_Chg;       { Get a new directory from the table }
  313. var
  314.   temp : string[50] ;
  315. begin
  316.     E_use := E_Use + 1;
  317.     temp := DirTable[E_use];
  318.     if temp[2] <> ':' then
  319.       temp := CurDrive + ':' + temp;
  320.     temp[1] := CurDrive ;
  321.     DirTable[E_use] := temp;
  322.     Buffer := DirTable[E_use] + '\????????.???' + Chr( 0); {3.0}
  323.     Buffer1 := DirTable[E_use] ;
  324.     GoToXY(1,Y+1);
  325.     ClrEol;
  326.     Writeln(Buffer1);
  327.     X := X + 1;
  328.     if X > 75 then begin
  329.       X := Z;
  330.       Z := Z+1;
  331.     end;
  332.     if Z > 75 then begin
  333.       Z := 26;
  334.       X := 25;
  335.     end;
  336.     GoToXY(X,Y);
  337.     if (Z and 1) = 0 then Write('.')     { This puts a . on the screen each }
  338.     else Write('*');                     { This puts a * on the screen each }
  339.     if length(Buffer1) = 1 then Buffer1 := '';
  340.     for I := 1 to length(Buffer) do
  341.       Mask[I] := Buffer[I];
  342. end;
  343.  
  344. procedure FindDate;              { Translate the Date from the Disk to }
  345. begin                            { Something readable }
  346.     FileMonth := 0;              { yyyyyyymmmmddddd  in bits}
  347.     FileDay := 0;
  348.     FileDateDos := MemW[Seg(DTA):Ofs(DTA)+24];
  349.     FileYear := FileDateDos shr 9;  { drop off the last 9 positions }
  350.     FileYear := FileYear + 80;      { years are added to base year of 1980 }
  351.     FileWork := FileDateDos shl 7;  { drop off the first 7 positions }
  352.     FileMonth := FileWork shr 12;   { now move it back to the right }
  353.     FileWork := FileDateDos shl 11; { drop off the left 11 positions }
  354.     FileDay := FileWork shr 11;     { now move back to the right }
  355. end;
  356.  
  357. procedure FindTime;              { Get the time and put it in a format that }
  358. begin                            { we can use. The Dos Format in bits is    }
  359.     FileHour := 0;               { hhhhhmmmmmmsssss }
  360.     FileMinute := 0;
  361.     FileHourDos := MemW[Seg(DTA):Ofs(DTA)+22];
  362.     FileHour := FileHourDos shr 11;     { Shift it around so the minutes and }
  363.     FileWork := FileHourDos shl 5;      { seconds disappear }
  364.     FileMinute := FileWork shr 10;
  365. end;
  366.  
  367. procedure FindSize;              { Get the file size and format it so we can }
  368. begin                            { use it                                    }
  369.     FileWork := MemW[Seg(DTA):Ofs(DTA)+26]; { Get from DTA, Low byte of size }
  370.     FileLow := FileWork;                    { Save Low byte size             }
  371.     FileWork2 := FileWork shr 15;           { Is the High bit on             }
  372.     FileWork3 := FileWork2 * 32768.0;       { yes! Save the size             }
  373.     FileWork2 := FileWork shl 1;            { Get rid of high bit            }
  374.     FileWork := FileWork2 shr 1;            { Now back to where we were      }
  375.     FileWork3 := FileWork3 + FileWork;      { Lets add them together         }
  376.     FileWork := MemW[Seg(DTA):Ofs(DTA)+28]; { Get from DTA, High byte        }
  377.     FileHigh := FileWork;                   { Save High byte size            }
  378.     FileWork3 := FileWork3 + (FileWork * 65536.0);    { Make size total      }
  379. end;
  380.  
  381. procedure PrintDTA;
  382. var
  383.    FileAttr            : Byte;
  384. begin
  385.     FileAttr := Byte(Mem[Seg(DTA):Ofs(DTA)+21]);
  386.     if FileAttr > 31 then        { File Not Archived  But we won't print this }
  387.     begin
  388.       FileAttr := FileAttr - 32;
  389.     end;
  390.     DirectryRec.FileAttributes := '      ';  { Make it all spaces }
  391.     if FileAttr > 15 then        { This is a directory entry      }
  392.     begin                        { Let's do it to it              }
  393.       FileAttr := FileAttr - 16;
  394.       E := E + 1;
  395.       Buffer2 := Buffer1;
  396.       A := Length(Buffer2) + 1;
  397.       B := Length(NamR);
  398.       C := 1;
  399.       Buffer2[A] := '\';
  400.       repeat
  401.         A := A + 1;
  402.         Buffer2[A] := NamR[C];
  403.         C := C + 1;
  404.       until C > B;
  405.       if Buffer2[2]<>':' then
  406.           Buffer2 := CurDrive + ':' + Buffer2;
  407.       Buffer2[0] := Chr(A - 1);
  408.       DirectryRec.FileAttributes[4] := '*';      { Sub Directry }
  409.       DirTable[ E ] := Buffer2;
  410.     end;
  411.     if FileAttr > 7 then
  412.     begin
  413. (*    DirectryRec.FileAttributes[4] := 'V';  { Volume Label } Volume labels *)
  414.       FileAttr := FileAttr - 8               { don't come back on this call }
  415.     end;                                     { for some reason }
  416.     if FileAttr > 3 then
  417.     begin
  418.       DirectryRec.FileAttributes[3] := 'S';  { System File }
  419.       FileAttr := FileAttr - 4;
  420.     end;
  421.     if FileAttr > 1 then
  422.     begin
  423.        DirectryRec.FileAttributes[2] := 'H'; { Hidden File }
  424.        FileAttr := FileAttr - 2;
  425.     end;
  426.     if FileAttr > 0 then
  427.     begin
  428.        DirectryRec.FileAttributes[1] := 'R'; { Read Only }
  429.     end;
  430. end;
  431.  
  432. procedure FormatAndReleaseSort;  { Yep that is what it is }
  433. begin
  434.      DirectryRec.FileNme := '             ';  { Blank it out }
  435.      DirectryRec.FileNme := NamR;          { Get file name }
  436.      DirectryRec.FileNme[0] := Chr(13);    { Now make it 13 long }
  437.      DirectryRec.FileDir := Buffer1;       { Get Directory its in }
  438.      FindDate;                             { Make date readable  }
  439.      FindTime;                             { Time also }
  440.      FindSize;                             { File size }
  441.      DirectryRec.FileMO := FileMonth;      { Complete setting up }
  442.      DirectryRec.FileDA := FileDay;        { Sort Record }
  443.      DirectryRec.FileYR := FileYear;
  444.      DirectryRec.FileHR := FileHour;
  445.      DirectryRec.FileMN := FileMinute;
  446.      DirectryRec.FileSize := FileWork3;
  447.      DirectryRec.FileSiLow := FileLow;
  448.      DirectryRec.FileSiHigh := FileHigh;
  449.      SortRelease(DirectryRec);             { Let'er go! }
  450. End;
  451.  
  452. function GetDrive : char;
  453. var
  454.   al : byte;
  455.   dr : char absolute al;
  456. begin
  457. {-- Get current drive letter in AL --}
  458.   Regs.AX := $19 shl 8;
  459.   MsDos(Regs);
  460.   GetDrive := Chr(lo(Regs.AX) + $41);
  461. end;
  462.  
  463. procedure Inp;    { ReadDirs this procedure is forward declared in SORT.BOX }
  464. begin                            { This reads the directories and releases }
  465.                                  { to the sort }
  466.   if ParamCount<>0 then DriveString:=Paramstr(1)
  467.   else
  468.     begin
  469.     DriveString := GetDrive;
  470.     end;
  471.   NotDir := True;
  472.   E := 0; E_Use := 0;
  473.   for drive_ctr:=1 to length(DriveString) do
  474.   begin
  475.     E := succ(E);
  476.     CurDrive:=UpCase(DriveString[drive_ctr]);
  477.     Buffer := CurDrive + ':';
  478.     NotDir := True;
  479.     Buffer1 := ''; Buffer2 := Buffer; DirTable[E] := Buffer;
  480.     Buffer[ length(Buffer) + 1 ] := Chr(0);
  481.     Buffer[0] := chr(length(buffer));
  482.     FillChar(DTA,SizeOf(DTA),0);        { Initialize the DTA buffer }
  483.     FillChar(Mask,SizeOf(Mask),0);      { Initialize the mask }
  484.     FillChar(NamR,SizeOf(NamR),0);      { Initialize the file name }
  485.     SetUpDTA;
  486.     Error := 0;
  487.     While E_Use < E do
  488.     begin
  489.          Set_Up_Dir_Chg;
  490.          ReadFirst;                { This does the first read for a directory }
  491.          if (Error = 0) then
  492.          begin
  493.               I := 1;
  494.               SetUpNamR;
  495.               if NamR[1] = '.' then NotDir := False;
  496.               if NotDir and  (Error = 0) then
  497.               begin
  498.                   PrintDTA;              { This gets the file attributes }
  499.                   FormatAndReleaseSort;  { Build the record }
  500.               end;
  501.          end;
  502.          while (Error = 0) do begin
  503.            NotDir := True;
  504.            ReadNext;               { This reads other entries in directory but }
  505.            if (Error = 0) then     { the first }
  506.            begin
  507.                I := 1;
  508.                SetUpNamR;
  509.                if NamR[1] = '.' then NotDir := False; { Is it a dot directory }
  510.                if NotDir and (Error = 0) then         { No it is not }
  511.                begin
  512.                    PrintDTA;
  513.                    FormatAndReleaseSort;
  514.                end;
  515.            end;
  516.          end;
  517.     end;
  518.   end;
  519.   Writeln;                       { All done reading the directories }
  520.   Write('Sorting the Directory Data');
  521.   ClrEol;
  522. end;                             { End of procedure Inp  }
  523.  
  524. function Less; { this boolean function hass two parameters, X and Y }
  525.               { and is forward declared in SORT.BOX }
  526. var
  527.   FirstDir      : DirRec absolute X;
  528.   SecondDir     : DirRec absolute Y;
  529. begin
  530.   if option = '3' then               { Tree Directory option }
  531.   begin
  532.       Less := (FirstDir.FileDir < SecondDir.FileDir)
  533.                              or
  534.              ((FirstDir.FileDir = SecondDir.FileDir)                      and
  535.               (FirstDir.FileAttributes[4] < SecondDir.FileAttributes[4]))
  536.                              or       { FileAttr[4] is the sub dir code pos }
  537.              ((FirstDir.FileDir = SecondDir.FileDir) and
  538.               (FirstDir.FileAttributes[4] = SecondDir.FileAttributes[4])  and
  539.               (FirstDir.FileNme < SecondDir.FileNme));
  540.   end
  541.   else                                { Sorted file option }
  542.   begin                                  { this tells the sort which of the }
  543.       Less := (FirstDir.FileNme < SecondDir.FileNme)      { two entries are }
  544.                             or
  545.              ((FirstDir.FileNme = SecondDir.FileNme) and  { first and which }
  546.               (FirstDir.FileDir < SecondDir.FileDir));    { is second }
  547.   end;
  548. end;
  549.  
  550. procedure SetUpOldArea;                  { We need to keep the old }
  551. begin                                    { Stuff around to see if  }
  552.      OldName := DirectryRec.FileNme;     { Matches the new stuff   }
  553.      OldDir  := DirectryRec.FileDir;     { This is used for the duplicate }
  554.      OldAttr := DirectryRec.FileAttributes;  { compares }
  555.      OldDA := DirectryRec.FileDA;
  556.      OldMO := DirectryRec.FileMO;
  557.      OldYR := DirectryRec.FileYR;
  558.      OldHR := DirectryRec.FileHR;
  559.      OldMN := DirectryRec.FileMN;
  560.      OldSI := DirectryRec.FileSize;
  561. end;
  562.  
  563. procedure FixMinute;             { Make the time readable }
  564. begin                            { put a 0 in front of one }
  565.     if length(WrkMN) = 1 then    { character minutes }
  566.     begin
  567.        WrkMN := '0' + WrkMn;
  568. {       WrkMN[2] := WrkMN[1];
  569.        WrkMN[1] := '0';
  570.        WrkMN[0] := Chr(2);          }
  571.    end;
  572. end;
  573.  
  574. procedure HeadingDupe;           { Headings for the reports }
  575. begin
  576.      PageNo := PageNo + 1;
  577.      Writeln(FilVar,'');
  578.      Write(FilVar,'   Directory list for duplicate files.   ',Datestr,' ',Timestr);
  579.      Writeln(FilVar,'  Page ',PageNo);
  580.      Writeln(FilVar,'      * = Sub Dir: R = Read only; H = Hidden: S = System');
  581.      Writeln(FilVar,'      Files          Date   Time      Size     Directory ');
  582.      WriteLn(FilVar,'');
  583. end;
  584.  
  585. procedure HeadingAll;            { Heading for the reports }
  586. begin
  587.      PageNo := PageNo + 1;
  588.      Writeln(FilVar,'');
  589.      Write(FilVar,'      Directory list for all files.      ',Datestr,' ',Timestr);
  590.      Writeln(FilVar,'  Page ',PageNo);
  591.      Writeln(FilVar,'      * = Sub Dir: R = Read only: H = Hidden: S = System');
  592.      Writeln(FilVar,'      Files          Date   Time      Size     Directory ');
  593.      WriteLn(FilVar,'');
  594. end;
  595.  
  596. procedure HeadingTree;            { Heading for the Tree reports }
  597. begin
  598.      PageNo := PageNo + 1;
  599.      Writeln(FilVar,'');
  600.      Write(FilVar,'  Tree Directory list for all files.      ',Datestr,' ',Timestr);
  601.      Writeln(FilVar,'  Page ',PageNo);
  602.      Writeln(FilVar,'      * = Sub Dir: R = Read only: H = Hidden: S = System');
  603.      Writeln(FilVar,'      Files          Date   Time      Size');
  604. end;
  605.  
  606. procedure OutP; { this procedure is forward declared in SORT.BOX }
  607. begin                            { This takes the sorted data and creates }
  608.    ClrScr;                       { the required reports (Screen or Paper) }
  609.    OldName := '           ';     { Clear out the field }
  610.    NumberRecs := 0;
  611.    OldDir := '            ';
  612.    DirCont := False;
  613.    Buffer[3] := chr(0);          { Shorten the drive identifier here }
  614.    Buffer[0] := chr(2);
  615.    if print then
  616.    begin
  617.        if DiskOutput then
  618.        begin
  619.           GoToXY(24,15);
  620.           Write('Creating the file DIRECTRY.DTA');
  621.        end
  622.        else
  623.        begin
  624.           GoToXY(30,15);        { This gives you something to look at on the }
  625.           Write('Printing the Report'); { Screen }
  626.        end;
  627.    end;
  628.    if Option = '1' then
  629.         HeadingDupe;              { Do you want the Duplicate }
  630.    if Option = '2' then
  631.         HeadingAll;               { Do you want all the Directories }
  632.    if Option = '3' then
  633.         HeadingTree;              { Do you want the Tree Dir }
  634.    repeat
  635.        SortReturn(DirectryRec);         { Hay it's back, just like magic }
  636.        NumberRecs := NumberRecs + 1;
  637.        DiskUse := DiskUse + DirectryRec.FileSize; { The actual file size }
  638.        FileUse := DirectryRec.FileSiLow;  { Lets play with the bits }
  639.        FileWork := FileUse and 2047;     { Turn off all bits but less than 2K }
  640.        FileWork2 := FileUse shr 11;      { Shift the 2K multiple into place }
  641.        if FileWork <> 0 then                     { If not exact 2K alignment }
  642.           FileUse2K := FileUse2k + FileWork2 + 1  { Then add 1 and save }
  643.        else                                       { If exact 2K alignment }
  644.           FileUse2K := FileUse2K + FileWork2;     { Just keep the multiple }
  645.        FileWork := FileUse and 4095;     { Turn off all bits but less then 4K }
  646.        FileWork2 := FileUse shr 12;      { Shift the 4K multiple into place }
  647.        if FileWork <> 0 then                     { If not exact 4K alignment }
  648.           FileUse4K := FileUse4K + FileWork2 + 1  { Then add 1 and save }
  649.        else                                       { If exact 4K alignment }
  650.           FileUse4K := FileUse4K + FileWork2;     { Just keep the multiple }
  651.        FileUse := DirectryRec.FileSiHigh;         { Now get the high byte }
  652.        FileUse2K := FileUse2K + (FileUse * 32);   { Save the 2K multiple }
  653.        FileUse4K := FileUse4K + (FileUse * 16);   { Save the 4K multiple }
  654.        if Option = '1' then            { You want just the Duplicate entries }
  655.        begin
  656.             WorkName := DirectryRec.FileNme;
  657.             if OldName < WorkName then     { its not duplicate }
  658.             begin
  659.                 SetUpOldArea;
  660.                 if MatchFound then
  661.                 begin
  662.                     MatchFound := False;
  663.                     Writeln(FilVar,'');
  664.                     ScreenLines := ScreenLines + 1;
  665.                 end;
  666.             end
  667.             else                          { Yes it is }
  668.             begin
  669.                 if not MatchFound then
  670.                 begin
  671.                      if ((print) and (ScreenLines > 50))  { 50 on paper is ok }
  672.                       or ((not print) and (ScreenLines > 17)) then
  673.                      begin                     { 17 is about all you want }
  674.                          if print then         { on the screen at a time }
  675.                          begin
  676.                              Writeln(FilVar,#$0C);
  677.                          end
  678.                          else
  679.                          begin
  680.                              Write('                             More');
  681.                              Read(Kbd,Temp); { I'll wait until you read these }
  682.                              ClrScr;         { Lets start anew }
  683.                          end;
  684.                          HeadingDupe;        { Put the heading back }
  685.                          ScreenLines := 0;   { I got nothing on the screen }
  686.                      end;
  687.                      Write(FilVar,OldAttr);  { Write the old data }
  688.                      Write(FilVar,OldName,' ');
  689.                      Write(FilVar,OldMO:2,'/',OldDA:2,'/',OldYR);
  690.                      Str(OldMN,WrkMN);       { Convert numeric to string }
  691.                      FixMinute;              { now make it more readable }
  692.                      Write(FilVar,' ', OldHR:2,':',WrkMN);
  693.                      Write(FilVar,' ');      { Continue printing }
  694.                      Write(FilVar,OldSI:9:0);  { Print Size }
  695.                      Write(FilVar,' ');      { Continue printing }
  696.                      if length(OldDir) > 0 then   { Is it the main directory }
  697.                          Writeln(FilVar,OldDir)   { Nope }
  698.                      else
  699.                          Writeln(FilVar,'\');   { this is the main directory }
  700.                      ScreenLines := ScreenLines + 1; { Its one more than it was }
  701.                 end;
  702.                 Write(FilVar,DirectryRec.FileAttributes); { Lets write the current }
  703.                 Write(FilVar,DirectryRec.FileNme,' ');    { Record }
  704.                 Write(FilVar,DirectryRec.FileMO:2,'/');
  705.                 Write(FilVar,DirectryRec.FileDA:2,'/');
  706.                 Write(FilVar,DirectryRec.FileYR);
  707.                 Str(DirectryRec.FileMN, WrkMN);
  708.                 FixMinute;
  709.                 Write(FilVar,' ',DirectryRec.FileHR:2,':',WrkMN);
  710.                 Write(FilVar,' ');
  711.                 Write(FilVar,DirectryRec.FileSize:9:0);
  712.                 Write(FilVar,' ');
  713.                 if length(DirectryRec.FileDir) > 1 then
  714.                     Writeln(FilVar,DirectryRec.FileDir)
  715.                 else
  716.                     Writeln(FilVar,'\');      { this is the main directory }
  717.                 ScreenLines := ScreenLines + 1;
  718.                 SetUpOldArea;
  719.                 MatchFound := True;
  720.             end;
  721.        end;
  722.        if Option = '2' then      { You want them all }
  723.        begin
  724.            if ((print) and (ScreenLines > 50))
  725.             or ((not print) and (ScreenLines > 18)) then
  726.            begin
  727.                 if print then
  728.                 begin
  729.                     Writeln(FilVar,#$0C);
  730.                 end
  731.                 else
  732.                 begin
  733.                     Write('                             More');
  734.                     Read(Kbd,Temp);
  735.                     ClrScr;
  736.                 end;
  737.                 HeadingAll;
  738.                 ScreenLines := 0;
  739.            end;
  740.            Write(FilVar,DirectryRec.FileAttributes);
  741.            Write(FilVar,DirectryRec.FileNme,' '); { Let's show'em what we found }
  742.            Write(FilVar,DirectryRec.FileMO:2,'/');
  743.            Write(FilVar,DirectryRec.FileDA:2,'/');
  744.            Write(FilVar,DirectryRec.FileYR);
  745.            Str(DirectryRec.FileMN, WrkMN);
  746.            FixMinute;
  747.            Write(FilVar,' ',DirectryRec.FileHR:2,':',WrkMN);
  748.            Write(FilVar,' ');
  749.            Write(FilVar,DirectryRec.FileSize:9:0);
  750.            Write(FilVar,' ');
  751.            if length(DirectryRec.FileDir) > 1 then
  752.                Writeln(FilVar,DirectryRec.FileDir)
  753.            else
  754.                Writeln(FilVar,'\');
  755.            ScreenLines := ScreenLines + 1;
  756.        end;
  757.        if Option = '3' then
  758.        begin
  759.            if ((print) and (ScreenLines > 50))
  760.              or ((not print) and (ScreenLines > 18)) then
  761.            begin
  762.                 if print then
  763.                 begin
  764.                     Writeln(FilVar,#$0C);
  765.                 end
  766.                 else
  767.                 begin
  768.                     Write('                             More');
  769.                     Read(Kbd,Temp);
  770.                     ClrScr;
  771.                 end;
  772.                 HeadingTree;
  773.                 ScreenLines := 0;
  774.                 DirCont := True;
  775.                 OldDir := '         ';
  776.            end;
  777.            if OldDir <> DirectryRec.FileDir then   { print the dir were in }
  778.            begin
  779.                Writeln(FilVar,'');
  780.                Write(FilVar,'  Directory ');
  781.                begin
  782.                    if length(DirectryRec.FileDir) > 1 then
  783.                        Write(FilVar,DirectryRec.FileDir)
  784.                    else
  785.                        Write(FilVar,'\');
  786.                end;
  787.                if DirCont then
  788.                begin
  789.                   DirCont := False;
  790.                   Writeln(FilVar,'    (cont.)');
  791.                end
  792.                else
  793.                Writeln(FilVar,'');
  794.                OldDir  := DirectryRec.FileDir;
  795.                Writeln(FilVar,'');
  796.                ScreenLines := ScreenLines + 3;
  797.            end;
  798.            Write(FilVar,DirectryRec.FileAttributes);
  799.            Write(FilVar,DirectryRec.FileNme,' '); { Let's show'em what we found }
  800.            Write(FilVar,DirectryRec.FileMO:2,'/');
  801.            Write(FilVar,DirectryRec.FileDA:2,'/');
  802.            Write(FilVar,DirectryRec.FileYR);
  803.            Str(DirectryRec.FileMN, WrkMN);
  804.            FixMinute;
  805.            Write(FilVar,' ',DirectryRec.FileHR:2,':',WrkMN);
  806.            Write(FilVar,' ');
  807.            Writeln(FilVar,DirectryRec.FileSize:9:0);
  808.            ScreenLines := ScreenLines + 1;
  809.        end;
  810.    until SortEOS;                { Do it until its done }
  811. end;
  812.  
  813. begin                   {  Main program  }
  814.   ClrScr;
  815.   Buffer := '';
  816.   DiskUse := 0;                           { Zero out field }
  817.   FileUse := 0;                           { Zero out field }
  818.   FileUse2K := 0;                         { Zero out field }
  819.   FileUse4K := 0;                         { Zero out field }
  820.   Time;                                   { Get the time }
  821.   Date;                                   { Get the date }
  822.   FirstTime := True;                      { First time here }
  823.   MatchFound := False;                    { Haven't found any matches yet }
  824.   GoToXY(10,1);                           { Fill the screen with data }
  825.   Write('Directory List Program   Version 2.1'); { This is it }
  826.   GoToXY(10,3);
  827.   Write('Ver 2.0 - Written and Copyright (C) by');
  828.   GoToXY(20,4);
  829.   Write('Karson W. Morrison');            { This is who did it }
  830.   GoToXY(20,5);
  831.   Write('March 25, 1985');                 { And When }
  832.   GoToXY(10,7);
  833.   Write('Ver 2.1 - Modifications by');
  834.   GoToXY(20,8);
  835.   Write('Ray Bobak');            { This is who did it }
  836.   GoToXY(20,9);
  837.   Write('October 27, 1985');                 { And When }
  838.   GoToXY(10,11);
  839.   Write('OPTIONS:');
  840.   GoToXY(11,12);
  841.   Write('List only Duplicate files on the disk: (1)');
  842.   GoToXY(11,13);
  843.   Write('List the entire directory of the disk: (2)');
  844.   GoToXY(11,14);
  845.   Write('List a Sorted Tree Dir of the disk :   (3)');
  846.   GoToXY(22,21);
  847.   Write('For output on printer enter (P) prior to number option');
  848.   GoToXY(22,22);
  849.   Write('For output on DIRECTRY.DTA enter (F) prior to number option');
  850.   GoToXY(14,16);
  851.   Write('Option: ');
  852.   read(Kbd,Option);
  853.   GoToXY(22,16);
  854.   Writeln(Upcase(Option));
  855.   Print := False;
  856.   Assign(FilVar,'CON:');
  857.   if Upcase(Option) = 'P' then
  858.   begin                          { Set up printer for listing }
  859.       Print := True;
  860.       Assign(FilVar,'LST:');
  861.       GoToXY(22,16);
  862.       read(Kbd,Option);
  863.       GoToXY(22,16);
  864.       Writeln(Option);
  865.   end;
  866.   if Upcase(Option) = 'F' then
  867.   begin                          { Set up file for listing }
  868.       Print := True;
  869.       DiskOutput := True;
  870.       Assign(FilVar,'DIRECTRY.DTA');
  871.       GoToXY(22,16);
  872.       read(Kbd,Option);
  873.       GoToXY(22,16);
  874.       Writeln(Option);
  875.   end;
  876.   Rewrite(FilVar);
  877.   Writeln;
  878.   ScreenLines := 0;
  879.   PageNo := 0;
  880.   GoToXY(1,17);
  881.   X := 25; Y := 17; Z := 26;
  882.   Writeln('Reading the Directories');
  883.   Write('\');
  884.   SortResult := TurboSort(SizeOf(DirectryRec)); { this does the call to the sort }
  885.   if SortResult > 1 then                    { if the sort don't work   }
  886.   begin                                     { This maybe what is wrong }
  887.       if SortResult = 3 then Writeln('Not enouth memory for sorting');
  888.       if SortResult = 9 then Writeln('More than 32767 records being sorted');
  889.       if sortresult = 10 then Writeln('Disk error during sorting (bad or full)');
  890.       if SortResult = 11 then Writeln('Read error during sort (Probably bad disk)');
  891.       if sortResult = 12 then Writeln('File creation error (directory may be full)');
  892.   end;
  893.   Writeln;
  894.   if print then
  895.   begin
  896.       Writeln(FilVar,'');
  897.       Write(FilVar,'  Number of Directories: ',E-1);
  898.       Writeln(FilVar,'  Number of Files: ',NumberRecs-E+1);
  899.       Writeln(FilVar,'  Disk Space used           ',DiskUse:11:0);
  900.       Writeln(FilVar,'  Disk Space used 4K blocks ',(FileUse4K * 4096.0):11:0);
  901.       Writeln(FilVar,'  Disk Space used 2K blocks ',(FileUse2K * 2048.0):11:0);
  902.       If not DiskOutput then
  903.          Writeln(FilVar,#$0C);
  904.       GoToXY(1,15);   { this is for the Writeln below this }
  905.   end;
  906.   If DiskOutput then close(FilVar);
  907.   Write('  Number of Directories: ',E-1);
  908.   Write('  Number of Files: ',NumberRecs-E+1);
  909.   ClrEol;
  910.   Writeln;
  911.   Writeln('  Disk Space used           ',DiskUse:11:0);
  912.   Writeln('  Disk Space used 4K blocks ',(FileUse4K * 4096.0):11:0);
  913.   Writeln('  Disk Space used 2K blocks ',(FileUse2K * 2048.0):11:0);
  914. end.
  915.